unit uDZLib;

interface

{$include DZCompiler.inc}

uses
  SysUtils, Classes, uDZLibApi{$ifdef d6_or_higher}, DateUtils {$endif};

type

{$ifndef UNICODE}

  RawByteString = AnsiString;

  UnicodeString = WideString;
  UnicodeChar = WideChar;

{$else ifdef d2009_or_higher}

  UnicodeChar = WideChar;

{$endif}

  TStreamPos = {$ifdef d6_or_higher} Int64 {$else} Longint {$endif};

  TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax, zcLevel1, zcLevel2,
    zcLevel3, zcLevel4, zcLevel5, zcLevel6, zcLevel7, zcLevel8, zcLevel9);

  TZStrategy = (zsDefault, zsFiltered, zsHuffman, zsRLE, zsFixed);

  TZError = (zeError, zeStreamError, zeDataError, zeMemoryError, zeBufferError, zeVersionError );

  TZFlush = (zfNoFlush, zfPartialFlush, zfSyncFlush, zfFullFlush, zfFinish, zfBlock, zfTrees);

  PGZHeader = ^TGZHeader;
  TGZHeader = packed record
    Id1: Byte;
    Id2: Byte;
    Method: Byte;
    Flags: Byte;
    Time: Cardinal;
    ExtraFlags: Byte;
    OS: Byte;
  end;

  PGZTrailer = ^TGZTrailer;
  TGZTrailer = packed record
    Crc: Longint;
    Size: Cardinal;
  end;
  
const
  ZLevels: Array [TZCompressionLevel] of Integer = (Z_NO_COMPRESSION, Z_BEST_SPEED,
    Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION, 1, 2, 3, 4, 5, 6, 7, 8, 9);

  ZStrategies: Array [TZStrategy] of Integer = (Z_DEFAULT_STRATEGY, Z_FILTERED,
    Z_HUFFMAN_ONLY, Z_RLE, Z_FIXED);

  ZErrors: Array [TZError] of Integer = (Z_ERRNO, Z_STREAM_ERROR,
    Z_DATA_ERROR, Z_MEM_ERROR, Z_BUF_ERROR, Z_VERSION_ERROR);

  ZFlushes: Array [TZFlush] of Integer = (Z_NO_FLUSH, Z_PARTIAL_FLUSH,
    Z_SYNC_FLUSH, Z_FULL_FLUSH, Z_FINISH, Z_BLOCK, Z_TREES);

type
  EZLibErrorClass = class of EZlibError;

  EZLibError = class(Exception)
  private
    FErrorCode: Integer;
  public
    constructor Create(code: Integer; const dummy: String = ''); overload;
    constructor Create(error: TZError; const dummy: String = ''); overload;
    property ErrorCode: Integer read FErrorCode write FErrorCode;
  end;

  EZCompressionError = class(EZLibError);
  EZDecompressionError = class(EZLibError);
  
  TDzWrapperStream = class(TStream)
  private
    FStream: TStream;
    FZStream: TZStreamRec;
    FBuffer: array [Word] of Byte;
  protected
    constructor Create(stream: TStream);
    function StreamRead(var buffer; count: Longint): Longint; {$ifdef d2005_or_higher}inline;{$endif}
    function StreamWrite(const buffer; count: Longint): Longint; {$ifdef d2005_or_higher}inline;{$endif}
    function StreamSeek(offset: Longint; origin: Word): Longint; {$ifdef d2005_or_higher}inline;{$endif}
    procedure StreamReadBuffer(var buffer; count: Longint); {$ifdef d2005_or_higher}inline;{$endif}
    procedure StreamWriteBuffer(const buffer; count: Longint); {$ifdef d2005_or_higher}inline;{$endif}
    procedure StreamWriteByte(buf: Byte); {$ifdef d2005_or_higher}inline;{$endif}
  end;

  TDzZCompressionStream = class(TDzWrapperStream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(dest: TStream; compressionLevel: TZCompressionLevel); overload;

    constructor Create(dest: TStream; compressionLevel: TZCompressionLevel;
      windowBits, memLevel: Integer; strategy: TZStrategy); overload;

    destructor Destroy; override;
    function Read(var buffer; count: Longint): Longint; override;
    function Write(const buffer; count: Longint): Longint; override;
    function Seek(offset: Longint; origin: Word): Longint; override;

    property CompressionRate: Single read GetCompressionRate;
  end;

  TDzZDecompressionStream = class(TDzWrapperStream)
  public
    constructor Create(source: TStream); overload;
    constructor Create(source: TStream; windowBits: Integer); overload;
    destructor Destroy; override;
    function Read(var buffer; count: Longint): Longint; override;
    function Write(const buffer; count: Longint): Longint; override;
    function Seek(offset: Longint; origin: Word): Longint; override;
  end;

  uDzGzipCompressionStream = class(TDzZCompressionStream)
  private
    FFileName: AnsiString;
    FComment: AnsiString;
    FDateTime: TDateTime;
    FTrailer: TGZTrailer;
  public
    constructor Create(dest: TStream; const fileName, comment: AnsiString;
      dateTime: TDateTime; compressionLevel: TZCompressionLevel;
      windowBits, memLevel: Integer; strategy: TZStrategy); overload;
    constructor Create(dest: TStream; const fileName, comment: AnsiString;
      dateTime: TDateTime); overload;  
    constructor Create(dest: TStream); overload;
    destructor  Destroy; override;
    function  Write(const buffer; count: Longint): Longint; override;
    property FileName: AnsiString read FFileName;
    property Comment : AnsiString read FComment;
    property DateTime: TDateTime  read FDateTime;
  end;

  uDzGzipDecompressionStream = class(TDzZDecompressionStream)
  private
    FFileName: AnsiString;
    FComment: AnsiString;
    FDateTime: TDateTime;
    FCrc: Longint;
    FSize: Cardinal;
  public
    constructor Create(source: TStream; windowBits: TZLibWindowBit); reintroduce;
    destructor  Destroy; override;
    function Read(var buffer; count: Longint): Longint; override;
    property FileName: AnsiString read FFileName;
    property Comment : AnsiString read FComment;
    property DateTime: TDateTime  read FDateTime;
  end;

function ZCompress(input: Pointer; inputLen: Integer; output: Pointer;
  outputLen: Integer; compressionLevel: TZCompressionLevel = zcDefault;
  windowBits: Integer = Z_DEFAULT_WINDOW_BITS;
  memLevel: Integer = Z_DEFAULT_MEM_LEVEL;
  strategy: TZStrategy = zsDefault): Integer;
  
function ZDecompress(input: Pointer; inputLen: Integer; output: Pointer;
  outputLen: Integer; windowbits: Integer = MAX_WBITS): Integer;

function ZCompressStream(input: TStream; output: TStream;
  compressionLevel: TZCompressionLevel = zcDefault;
  windowBits: Integer = Z_DEFAULT_WINDOW_BITS;
  memLevel: Integer = Z_DEFAULT_MEM_LEVEL;
  strategy: TZStrategy = zsDefault): Integer;

function ZDecompressStream(input: TStream; output: TStream;
  windowBits: Integer = Z_DEFAULT_WINDOW_BITS): Integer;

implementation

const
  SZInvalid = 'Invalid ZStream operation!';
  SGZInvalid = 'Invalid GZStream operation!';

  GZ_ZLIB_WINDOWBITS = -15;
  GZ_ZLIB_MEMLEVEL   = 9;

  GZ_ASCII_TEXT  = $01;
  GZ_HEADER_CRC  = $02;
  GZ_EXTRA_FIELD = $04;
  GZ_FILENAME    = $08;
  GZ_COMMENT     = $10;
  GZ_RESERVED    = $E0;

  GZ_EXTRA_DEFAULT = 0;
  GZ_EXTRA_MAX     = 2;
  GZ_EXTRA_FASTEST = 4;

{$ifndef d6_or_higher}

type
  PWord = ^Word;

{ Days between TDateTime basis (12/31/1899) and Unix time_t basis (1/1/1970) }

const
  UnixDateDelta = 25569;

function DateTimeToUnix(const AValue: TDateTime): Cardinal;
begin
  Result := Round((AValue - UnixDateDelta) * SecsPerDay);
end;

function UnixToDateTime(const AValue: DWORD): TDateTime;
begin
  Result := AValue / SecsPerDay + UnixDateDelta;
end;

{$endif}

function ZCompressCheck(code: Integer): Integer;
begin
  Result := code;

  if code < 0 then
  begin
    raise EZCompressionError.Create(code);
  end;
end;

function ZDecompressCheck(code: Integer; raiseBufferError: Boolean = True): Integer;
begin
  Result := code;

  if code < 0 then
  begin
    if (code <> Z_BUF_ERROR) or raiseBufferError then
    begin
      raise EZDecompressionError.Create(code);
    end;
  end;
end;

function ZCompress(input: Pointer; inputLen: Integer; output: Pointer;
  outputLen: Integer; compressionLevel: TZCompressionLevel;
  windowBits, memLevel: Integer; strategy: TZStrategy): Integer;
var
  ret: Integer;
  strm: TZStreamRec;
begin
  FillChar(strm, SizeOf(strm), 0);
  if deflateInit2_(strm, ZLevels[compressionLevel], Z_DEFLATED, windowbits,
    Z_DEFAULT_MEM_LEVEL, ZStrategies[strategy], ZLIB_VERSION,
    SizeOf(strm)) <> Z_OK then
  begin
    Result := -1;
    Exit;
  end;

  try
    strm.next_in := input;
    strm.avail_in := inputLen;
    strm.next_out := output;
    strm.avail_out := outputLen;

    ret := deflate(strm, Z_FINISH);
    if ret = Z_NEED_DICT then ret := Z_DATA_ERROR;
    if ret in [Z_OK, Z_STREAM_END] then
      Result := outputLen - strm.total_out
    else
      Result := -1;
  finally
    deflateEnd(strm);
  end;
end;

function ZCompressStream(input: TStream; output: TStream;
  compressionLevel: TZCompressionLevel;
  windowBits, memLevel: Integer; strategy: TZStrategy): Integer;
var
  ret, srcLen: Integer;
  strm: TZStreamRec;
  src: array [0..4095] of Byte;
  dest: array [0..4095] of Byte;
begin
  FillChar(strm, SizeOf(strm), 0);
  if deflateInit2_(strm, ZLevels[compressionLevel],
    Z_DEFLATED, windowbits, Z_DEFAULT_MEM_LEVEL, ZStrategies[strategy],
    ZLIB_VERSION, SizeOf(strm)) <> Z_OK then
  begin
    Result := -1;
    Exit;
  end;

  Result := 0;
  try
    while True do
    begin
      srcLen := input.Read(src, SizeOf(src));
      if srcLen = 0 then
      begin
        strm.next_in := nil;
        strm.avail_in := 0;
        strm.next_out := @dest;
        strm.avail_out := SizeOf(dest);
        deflate(strm, Z_FINISH);
        output.WriteBuffer(dest, SizeOf(dest) - strm.avail_out);
        Inc(Result, SizeOf(dest) - strm.avail_out);
        Exit;
      end;

      strm.next_in := @src;
      strm.avail_in := srcLen;
      strm.next_out := @dest;
      strm.avail_out := SizeOf(dest);

      while strm.avail_in > 0 do
      begin
        ret := deflate(strm, Z_NO_FLUSH);
        case ret of
          Z_OK:
            begin
              output.WriteBuffer(dest, SizeOf(dest) - strm.avail_out);
              Inc(Result, SizeOf(dest) - strm.avail_out);
            end;
          Z_STREAM_END:
            begin
              output.WriteBuffer(dest, SizeOf(dest) - strm.avail_out);
              Inc(Result, SizeOf(dest) - strm.avail_out);
              Exit;
            end;
          else
            raise EZCompressionError.Create(ret);
        end;
      end;
    end;
  finally
    deflateEnd(strm);
  end;
end;

function ZDecompress(input: Pointer; inputLen: Integer; output: Pointer;
  outputLen, windowBits: Integer): Integer;
var
  ret: Integer;
  strm: TZStreamRec;
begin
  FillChar(strm, SizeOf(strm), 0);
  if inflateInit2(strm, windowbits) <> Z_OK then
  begin
    Result := -1;
    Exit;
  end;

  try
    strm.next_in := input;
    strm.avail_in := inputLen;
    strm.next_out := output;
    strm.avail_out := outputLen;

    ret := inflate(strm, Z_FINISH);
    if ret = Z_NEED_DICT then ret := Z_DATA_ERROR;
    if ret in [Z_OK, Z_STREAM_END] then
      Result := outputLen - strm.total_out
    else
      Result := -1;
  finally
    inflateEnd(strm);
  end;
end;


function ZDecompressStream(input: TStream; output: TStream;
  windowBits: Integer = Z_DEFAULT_WINDOW_BITS): Integer;
var
  ret, srcLen: Integer;
  strm: TZStreamRec;
  src: array [0..4095] of Byte;
  dest: array [0..4095] of Byte;
begin
  FillChar(strm, SizeOf(strm), 0);
  if inflateInit2_(strm, windowbits, ZLIB_VERSION, SizeOf(strm)) <> Z_OK then
  begin
    Result := -1;
    Exit;
  end;

  Result := 0;
  try
    while True do
    begin
      srcLen := input.Read(src, SizeOf(src));
      if srcLen = 0 then
      begin
        strm.next_in := nil;
        strm.avail_in := 0;
        strm.next_out := @dest;
        strm.avail_out := SizeOf(dest);
        inflate(strm, Z_FINISH);
        output.WriteBuffer(dest, SizeOf(dest) - strm.avail_out);
        Inc(Result, SizeOf(dest) - strm.avail_out);
        Exit;
      end;

      strm.next_in := @src;
      strm.avail_in := srcLen;

      while strm.avail_in > 0 do
      begin
        strm.next_out := @dest;
        strm.avail_out := SizeOf(dest);
        ret := inflate(strm, Z_NO_FLUSH);
        case ret of
          Z_OK:
            begin
              output.WriteBuffer(dest, SizeOf(dest) - strm.avail_out);
              Inc(Result, SizeOf(dest) - strm.avail_out);
            end;
          Z_STREAM_END:
            begin
              output.WriteBuffer(dest, SizeOf(dest) - strm.avail_out);
              Inc(Result, SizeOf(dest) - strm.avail_out);
              Exit;
            end;
          else
            raise EZCompressionError.Create(ret);
        end;
      end;
    end;
  finally
    inflateEnd(strm);
  end;
end;

{ TDzWrapperStream }

constructor TDzWrapperStream.Create(stream: TStream);
begin
  inherited Create;
  FStream := stream;
end;

function TDzWrapperStream.StreamRead(var buffer; count: Longint): Longint;
begin
  Result := FStream.Read(buffer, count);
end;

function TDzWrapperStream.StreamWrite(const buffer; count: Longint): Longint;
begin
  Result := FStream.Write(buffer,count);
end;

function TDzWrapperStream.StreamSeek(offset: Longint; origin: Word): Longint;
begin
  Result := FStream.Seek(offset, origin);
end;

procedure TDzWrapperStream.StreamReadBuffer(var buffer; count: Longint);
begin
  FStream.ReadBuffer(buffer,count);
end;

procedure TDzWrapperStream.StreamWriteBuffer(const buffer; count: Longint);
begin
  FStream.WriteBuffer(buffer,count);
end;

procedure TDzWrapperStream.StreamWriteByte(buf: Byte);
begin
  FStream.WriteBuffer(buf, SizeOf(buf));
end;

{ TDzZCompressionStream }

constructor TDzZCompressionStream.Create(dest: TStream; compressionLevel: TZCompressionLevel);
begin
  inherited Create(dest);
  ZCompressCheck(deflateInit(FZStream, ZLevels[compressionLevel]));
end;

constructor TDzZCompressionStream.Create(dest: TStream; compressionLevel: TZCompressionLevel;
  windowBits, memLevel: Integer; strategy: TZStrategy);
begin
  inherited Create(dest);
  ZCompressCheck(deflateInit2(FZStream, ZLevels[compressionLevel],
    windowBits, memLevel, ZStrategies[strategy]));
end;

destructor TDzZCompressionStream.Destroy;
var
  r: Integer;
begin
  FZStream.next_in := nil;
  FZStream.avail_in := 0;
  try
    while True do
    begin
      FZStream.next_out := @FBuffer;
      FZStream.avail_out := SizeOf(FBuffer);
      r := ZCompressCheck(deflate(FZStream, ZFlushes[zfFinish]));
      StreamWriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out);
      if r = Z_STREAM_END then Break;
    end;
  finally
    deflateEnd(FZStream);
  end;

  inherited;
end;

function TDzZCompressionStream.Read(var buffer; count: Longint): Longint;
begin
  raise EZCompressionError.Create(SZInvalid);
end;

function TDzZCompressionStream.Write(const buffer; count: Longint): Longint;
begin
  Result := count;
  FZStream.next_in := @buffer;
  FZStream.avail_in := count;
  while FZStream.avail_in > 0 do
  begin
    FZStream.next_out := @FBuffer;
    FZStream.avail_out := SizeOf(FBuffer);
    ZCompressCheck(deflate(FZStream, ZFlushes[zfNoFlush]));
    StreamWriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out);
  end;
end;

function TDzZCompressionStream.Seek(offset: Longint; origin: Word): Longint;
begin
  if (offset = 0) and (origin = soFromCurrent) then
    Result := FZStream.total_in
  else raise EZCompressionError.Create(SZInvalid);
end;

function TDzZCompressionStream.GetCompressionRate: Single;
begin
  if FZStream.total_in = 0 then Result := 0
  else Result := (1.0 - (FZStream.total_out / FZStream.total_in)) * 100.0;
end;

{ TDzZDecompressionStream }

constructor TDzZDecompressionStream.Create(source: TStream);
begin
  inherited Create(source);
  ZDecompressCheck(inflateInit(FZStream));
end;

constructor TDzZDecompressionStream.Create(source: TStream; windowBits: Integer);
begin
  inherited Create(source);
  ZDecompressCheck(inflateInit2(FZStream, windowBits));
end;

destructor TDzZDecompressionStream.Destroy;
begin
  inflateEnd(FZStream);
  inherited Destroy;
end;

function TDzZDecompressionStream.Read(var buffer; count: Longint): Longint;
var
  r: Integer;
begin
  FZStream.next_out := @buffer;
  FZStream.avail_out := count;
  while FZStream.avail_out > 0  do
  begin
    if FZStream.avail_in = 0 then
    begin
      FZStream.avail_in := StreamRead(FBuffer, SizeOf(FBuffer));
      if FZStream.avail_in = 0 then Break;
      FZStream.next_in := @FBuffer;
    end;
    r := ZDecompressCheck(inflate(FZStream, ZFlushes[zfNoFlush]));
    if r = Z_STREAM_END then Break;
  end;
  Result := count - FZStream.avail_out;
end;

function TDzZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EZDecompressionError.Create(SZInvalid);
end;

function TDzZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if (offset = 0) and (origin = soFromBeginning) then
  begin
    ZDecompressCheck(inflateReset(FZStream));
    Result := FZStream.total_out;
  end
  else raise EZDecompressionError.Create(SZInvalid);
end;

{ uDzGzipCompressionStream }

constructor uDzGzipCompressionStream.Create(dest: TStream; const fileName,
  comment: AnsiString; dateTime: TDateTime);
begin
  Create(dest, fileName, comment, dateTime, zcDefault, GZ_ZLIB_WINDOWBITS,
    Z_DEFAULT_MEM_LEVEL, zsDefault);
end;

constructor uDzGzipCompressionStream.Create(dest: TStream);
begin
  Create(dest, '' , '', 0);
end;

constructor uDzGzipCompressionStream.Create(dest: TStream; const fileName, comment: AnsiString;
  dateTime: TDateTime; compressionLevel: TZCompressionLevel; windowBits, memLevel: Integer;
  strategy: TZStrategy);
var
  header: TGZHeader;
begin
  inherited Create(dest, zcDefault, windowBits, memLevel, strategy);
  FFileName := fileName;
  FComment := comment;
  FDateTime := dateTime;
  FillChar(header, SizeOf(TGZHeader), 0);
  header.Id1 := $1F;
  header.Id2 := $8B;
  header.Method := Z_DEFLATED;
  if FDateTime <> 0 then header.Time := DateTimeToUnix(FDateTime);
  header.ExtraFlags := GZ_EXTRA_DEFAULT;
  header.OS := 0;
  header.Flags := 0;
  if Length(fileName) > 0 then header.Flags := header.Flags or GZ_FILENAME;
  if Length(comment) > 0 then header.Flags := header.Flags or GZ_COMMENT;
  StreamWriteBuffer(header,SizeOf(TGZHeader));
  if Length(FFilename) > 0 then
  begin
    StreamWriteBuffer(Pointer(FFileName)^, Length(FFileName));
    StreamWriteByte(0);
  end;

  if Length(FComment) > 0 then
  begin
    StreamWriteBuffer(Pointer(FComment)^, Length(FComment));
    StreamWriteByte(0);
  end;

  FillChar(FTrailer,SizeOf(TGZTrailer),0);
end;

destructor uDzGzipCompressionStream.Destroy;
begin
  inherited;
  StreamWriteBuffer(FTrailer,SizeOf(TGZTrailer));
end;

function uDzGzipCompressionStream.Write(const buffer; count: Longint): Longint;
begin
  Result := inherited Write(buffer,count);
  FTrailer.Crc := crc32(FTrailer.Crc,buffer,Result);
  FTrailer.Size := FTrailer.Size + Cardinal(Result);
end;

{ uDzGzipDecompressionStream }

constructor uDzGzipDecompressionStream.Create(source: TStream; windowBits: TZLibWindowBit);

  function ReadNullString: AnsiString;
  var
    c: AnsiChar;
  begin
    Result := '';
    c := ' ';
    while c <> #0 do
    begin
      StreamReadBuffer(c,1);
      if c <> #0 then Result := Result + c;
    end;
  end;
var
  header: TGZHeader;
  size  : Integer;
begin
  inherited Create(source, -windowBits);

  StreamReadBuffer(header, SizeOf(TGZHeader));

  if (header.Id1 <> $1F) or (header.Id2 <> $8B) or (header.Method <> Z_DEFLATED)
    or ((header.Flags and GZ_RESERVED) <> 0) then
  begin
    raise EZDecompressionError.Create(zeDataError);
  end;

  if header.Time <> 0 then FDateTime := UnixToDateTime(header.Time)
  else FDateTime := 0;

  if (header.Flags and GZ_EXTRA_FIELD) <> 0 then
  begin
    StreamRead(size, SizeOf(Word));
    StreamSeek(size, soFromCurrent);
  end;

  FFileName := '';

  if (header.Flags and GZ_FILENAME) <> 0 then
    FFileName := ReadNullString;

  FComment := '';

  if (header.Flags and GZ_COMMENT) <> 0 then
    FComment := ReadNullString;

  if (header.Flags and GZ_HEADER_CRC) <> 0 then
    StreamSeek(SizeOf(Word), soFromCurrent);
  FCrc := 0;
  FSize := 0;
end;

destructor uDzGzipDecompressionStream.Destroy;
var
  trailer: TGZTrailer;
begin
  inherited;
  StreamRead(trailer,SizeOf(TGZTrailer));
  if (trailer.Crc <> FCrc) or (trailer.Size <> FSize) then
    raise EZDecompressionError.Create(zeDataError);
end;

function uDzGzipDecompressionStream.Read(var buffer; count: Longint): Longint;
begin
  Result := inherited Read(buffer,count);
  FCrc := crc32(FCrc,buffer,Result);
  FSize := FSize + Cardinal(Result);
end;

{ EZLibError }

constructor EZLibError.Create(code: Integer; const dummy: String);
begin
  inherited Create(_z_errmsg[2 - code]);
  FErrorCode := code;
end;

constructor EZLibError.Create(error: TZError; const dummy: String);
begin
  Create(ZErrors[error], dummy);
end;

end.
